library(tidyverse)
library(tidyboot)
library(ggplot2)
library(ggthemes)
library(knitr)
library(coda)
library(viridis)
library(here)
library(patchwork)
theme_set(theme_few())estimate_mode <- function(s) {
d <- density(s)
return(d$x[which.max(d$y)])
}
hpd_upper <- function(s){
m <- HPDinterval(mcmc(s))
return(m["var1","upper"])
}
hpd_lower <- function(s){
m <- HPDinterval(mcmc(s))
return(m["var1","lower"])
}
count_summary_fn <- function(x) x %>%
summarize(n = n()) %>%
mutate(stat = n / sum(n))
mean_ci_funs <- list("ci_lower" = ci_lower, "mean" = mean, "ci_upper" = ci_upper)h_state <- read_csv(here("/data/clean_data_true_state.csv"))## Parsed with column specification:
## cols(
## id = col_character(),
## condition_level = col_character(),
## response = col_double(),
## utt = col_character(),
## exp = col_character(),
## condition_name = col_character()
## )
h_state_summary <- h_state %>%
rename(emo = exp,
state = response,
manipulation = condition_name,
manipulation_level = condition_level) %>%
mutate(manipulation_level = ifelse(manipulation_level=="inf_goal", "inf", manipulation_level),
manipulation_level = ifelse(manipulation_level=="soc_goal", "soc", manipulation_level))%>%
group_by(manipulation, manipulation_level, utt, emo, state) %>%
tidyboot(summary_function = count_summary_fn,
statistics_functions = function(x) x %>%
summarise(across(stat, mean_ci_funs, .names = "{.fn}")))## `summarise()` has grouped output by 'manipulation', 'manipulation_level', 'utt', 'emo'. You can override using the `.groups` argument.
## `summarise()` has grouped output by '.id', 'manipulation', 'manipulation_level', 'utt', 'emo'. You can override using the `.groups` argument.
## `summarise()` has grouped output by 'manipulation', 'manipulation_level', 'utt', 'emo'. You can override using the `.groups` argument.
plot_state_emoIsComm <- h_state_summary[h_state_summary$manipulation == "emoIsComm_manipulation",] %>%
ggplot(., aes( x = state, y = mean, ymin = ci_lower, ymax = ci_upper))+
geom_col(position = position_dodge())+
geom_linerange(position = position_dodge())+
ggtitle("emoIsComm manipulation")+
theme(plot.title = element_text(hjust = 0.5))+
facet_grid(rows=vars(utt, emo), cols=vars(manipulation_level))
plot_state_goal <- h_state_summary[h_state_summary$manipulation == "goal_manipulation",] %>%
ggplot(., aes( x = state, y = mean, ymin = ci_lower, ymax = ci_upper))+
geom_col(position = position_dodge())+
geom_linerange(position = position_dodge())+
ggtitle("goal manipulation")+
theme(plot.title = element_text(hjust = 0.5))+
facet_grid(rows=vars(utt, emo), cols=vars(manipulation_level))
plot_state_state <- h_state_summary[h_state_summary$manipulation == "state_manipulation",] %>%
mutate(manipulation_level = factor(manipulation_level, levels = c("bad", "no_info", "good"))) %>%
ggplot(., aes( x = state, y = mean, ymin = ci_lower, ymax = ci_upper))+
geom_col(position = position_dodge())+
geom_linerange(position = position_dodge())+
ggtitle("state manipulation")+
theme(plot.title = element_text(hjust = 0.5))+
facet_grid(rows=vars(utt, emo), cols=vars(manipulation_level))
plot_state_inference <- plot_state_emoIsComm + plot_state_goal + plot_state_state
plot_state_inference## Warning: Width not defined. Set with `position_dodge(width = ?)`
## Warning: Width not defined. Set with `position_dodge(width = ?)`
## Warning: Width not defined. Set with `position_dodge(width = ?)`
# ggsave(here(paste("/models/figures/mb7_state_inference.pdf")), width = 12, height = 6)h_goal <- read_csv(here("/data/clean_data_goals.csv"))## Parsed with column specification:
## cols(
## id = col_character(),
## condition_level = col_character(),
## question = col_character(),
## response = col_double(),
## utt = col_character(),
## exp = col_character(),
## condition_name = col_character()
## )
h_goal_summary <- h_goal %>%
rename(emo = exp,
manipulation = condition_name,
manipulation_level = condition_level) %>%
mutate(manipulation_level = ifelse(manipulation_level=="inf_goal", "inf", manipulation_level),
manipulation_level = ifelse(manipulation_level=="soc_goal", "soc", manipulation_level))%>%
group_by(manipulation, manipulation_level, utt, emo, question, response) %>%
tidyboot(summary_function = count_summary_fn,
statistics_functions = function(x) x %>%
summarise(across(stat, mean_ci_funs, .names = "{.fn}")))## `summarise()` has grouped output by 'manipulation', 'manipulation_level', 'utt', 'emo', 'question'. You can override using the `.groups` argument.
## `summarise()` has grouped output by '.id', 'manipulation', 'manipulation_level', 'utt', 'emo', 'question'. You can override using the `.groups` argument.
## `summarise()` has grouped output by 'manipulation', 'manipulation_level', 'utt', 'emo', 'question'. You can override using the `.groups` argument.
h_inf_summary <- h_goal_summary[h_goal_summary$question=="informational goal",]
h_soc_summary <- h_goal_summary[h_goal_summary$question=="social goal",]informational goals
plot_inf_emoIsComm <- h_inf_summary[h_inf_summary$manipulation == "emoIsComm_manipulation",] %>%
ggplot(., aes( x = response, y = mean, ymin = ci_lower, ymax = ci_upper))+
geom_col(position = position_dodge())+
geom_linerange(position = position_dodge())+
ggtitle("emoIsComm manipulation")+
xlab("inf goal") +
theme(plot.title = element_text(hjust = 0.5))+
facet_grid(rows=vars(utt, emo), cols=vars(manipulation_level))
plot_inf_goal <- h_inf_summary[h_inf_summary$manipulation == "goal_manipulation",] %>%
ggplot(., aes( x = response, y = mean, ymin = ci_lower, ymax = ci_upper))+
geom_col(position = position_dodge())+
geom_linerange(position = position_dodge())+
ggtitle("goal manipulation")+
xlab("inf goal") +
theme(plot.title = element_text(hjust = 0.5))+
facet_grid(rows=vars(utt, emo), cols=vars(manipulation_level))
plot_inf_state <- h_inf_summary[h_inf_summary$manipulation == "state_manipulation",] %>%
mutate(manipulation_level = factor(manipulation_level, levels = c("bad", "no_info", "good"))) %>%
ggplot(., aes( x = response, y = mean, ymin = ci_lower, ymax = ci_upper))+
geom_col(position = position_dodge())+
geom_linerange(position = position_dodge())+
ggtitle("state manipulation")+
xlab("inf goal") +
theme(plot.title = element_text(hjust = 0.5))+
facet_grid(rows=vars(utt, emo), cols=vars(manipulation_level))
plot_inf_inference <- plot_inf_emoIsComm + plot_inf_state + plot_inf_goal
plot_inf_inference## Warning: Width not defined. Set with `position_dodge(width = ?)`
## Warning: Width not defined. Set with `position_dodge(width = ?)`
## Warning: Width not defined. Set with `position_dodge(width = ?)`
# ggsave(here(paste("/models/figures/mb7_inf_inference.pdf")), width = 12, height = 6)social goals
plot_soc_emoIsComm <- h_soc_summary[h_soc_summary$manipulation == "emoIsComm_manipulation",] %>%
ggplot(., aes( x = response, y = mean, ymin = ci_lower, ymax = ci_upper))+
geom_col(position = position_dodge())+
geom_linerange(position = position_dodge())+
ggtitle("emoIsComm manipulation")+
xlab("soc goal") +
theme(plot.title = element_text(hjust = 0.5))+
facet_grid(rows=vars(utt, emo), cols=vars(manipulation_level))
plot_soc_goal <- h_soc_summary[h_soc_summary$manipulation == "goal_manipulation",] %>%
ggplot(., aes( x = response, y = mean, ymin = ci_lower, ymax = ci_upper))+
geom_col(position = position_dodge())+
geom_linerange(position = position_dodge())+
ggtitle("goal manipulation")+
xlab("soc goal") +
theme(plot.title = element_text(hjust = 0.5))+
facet_grid(rows=vars(utt, emo), cols=vars(manipulation_level))
plot_soc_state <- h_soc_summary[h_soc_summary$manipulation == "state_manipulation",] %>%
mutate(manipulation_level = factor(manipulation_level, levels = c("bad", "no_info", "good"))) %>%
ggplot(., aes( x = response, y = mean, ymin = ci_lower, ymax = ci_upper))+
geom_col(position = position_dodge())+
geom_linerange(position = position_dodge())+
ggtitle("state manipulation")+
xlab("soc goal") +
theme(plot.title = element_text(hjust = 0.5))+
facet_grid(rows=vars(utt, emo), cols=vars(manipulation_level))
plot_soc_inference <- plot_soc_emoIsComm + plot_soc_goal + plot_soc_state
plot_soc_inference## Warning: Width not defined. Set with `position_dodge(width = ?)`
## Warning: Width not defined. Set with `position_dodge(width = ?)`
## Warning: Width not defined. Set with `position_dodge(width = ?)`
# ggsave(here(paste("/models/figures/mb7_soc_inference.pdf")), width = 12, height = 6)results_path <- "models/bda_results/"
model.files <- list.files(
path = paste(here(), results_path, sep = "/"),
pattern = "bda-M"
)
df.m <- map_dfr(model.files, function(model.file){
read_csv(here(paste(results_path, model.file, sep = "")),
col_types = cols(
iter = col_double(),
model = col_character(),
chain = col_double(),
manipulation = col_character(),
manipulation_level = col_character(),
parameter = col_character(),
utt = col_character(),
emo = col_character(),
value = col_character(),
prob = col_double(),
score = col_double()
))
})df.m %>%
filter(parameter == "parameter", is.na(emo)) %>%
ggplot(., aes(x = prob))+
geom_histogram(position = position_dodge())+
facet_grid(cols = vars(utt), scales = "free_x")## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
# ggsave(here("/models/figures/mb7_global_parameters.pdf"), width = 8, height = 5)df.m %>%
filter(parameter == "parameter", is.na(emo)) %>%
group_by(utt) %>%
summarize(
MAP = estimate_mode(prob),
cred_upper = hpd_upper(prob),
cred_lower = hpd_lower(prob)
) -> df_parameter_summary
df_parameter_summary %>%
kable(.)| utt | MAP | cred_upper | cred_lower |
|---|---|---|---|
| goalExp | 4.585671 | 4.810373 | 0.0067195 |
| goalScale | 8.101648 | 94.887985 | 0.0002936 |
| speakerOptimality | 11.430389 | 18.151587 | 0.6330936 |
df.m %>%
filter(parameter == "parameter", is.na(emo) == FALSE) %>%
ggplot(., aes(x = prob))+
geom_histogram(position = position_dodge())+
facet_grid(cols = vars(utt, emo), rows = vars(value), scales = "free_x")## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
# ggsave(here("/models/figures/mb7_prior_parameters.pdf"), width = 20, height = 5)df.m %>%
filter(parameter == "parameter", is.na(emo) == FALSE) %>%
group_by(utt, emo, value) %>%
summarize(
MAP = estimate_mode(prob),
cred_upper = hpd_upper(prob),
cred_lower = hpd_lower(prob)
) %>%
rename(prior = 'utt', level = 'emo') -> df_parameter_summary## `summarise()` has grouped output by 'utt', 'emo'. You can override using the `.groups` argument.
df_parameter_summary %>%
kable(.)| prior | level | value | MAP | cred_upper | cred_lower |
|---|---|---|---|---|---|
| emoIsCommPrior | communicative | NA | 0.7249253 | 0.9966845 | 0.0854412 |
| emoIsCommPrior | no_info | NA | 0.7970136 | 0.9559733 | 0.0218114 |
| emoIsCommPrior | noncommunicative | NA | 0.1965886 | 0.9666617 | 0.0454865 |
| infGoalPrior | inf | mu | 1.7836713 | 3.7539310 | 1.0142491 |
| infGoalPrior | inf | sigma | 0.8602859 | 2.8817960 | 0.1003043 |
| infGoalPrior | no_info | mu | 3.1976354 | 3.9713729 | 1.2396245 |
| infGoalPrior | no_info | sigma | 2.7304857 | 2.8397848 | 0.0205306 |
| infGoalPrior | soc | mu | 2.2007525 | 3.9384114 | 1.1132417 |
| infGoalPrior | soc | sigma | 0.7830124 | 2.8481489 | 0.0083831 |
| socGoalPrior | inf | mu | 2.5839419 | 3.9706656 | 1.1444114 |
| socGoalPrior | inf | sigma | 0.2279484 | 2.8426762 | 0.0461502 |
| socGoalPrior | no_info | mu | 3.1438213 | 3.9353185 | 1.1443663 |
| socGoalPrior | no_info | sigma | 2.7854985 | 2.9888604 | 0.1333197 |
| socGoalPrior | soc | mu | 3.6472665 | 3.8183528 | 1.0546376 |
| socGoalPrior | soc | sigma | 0.8964771 | 2.8320957 | 0.0387915 |
| statePrior | bad | mu | 5.5141442 | 5.9202755 | 1.1995607 |
| statePrior | bad | sigma | 1.4527751 | 2.8015206 | 0.0007453 |
| statePrior | good | mu | 3.0861868 | 5.8433853 | 1.2481192 |
| statePrior | good | sigma | 0.2929963 | 2.8938053 | 0.0279794 |
| statePrior | no_info | mu | 5.6165645 | 5.9832126 | 1.3448652 |
| statePrior | no_info | sigma | 0.5891282 | 2.8205601 | 0.0144962 |
df_state <- df.m %>%
filter(parameter == "state") %>%
mutate(state = as.numeric(value)) %>%
select(-value)
df_state_summary <- df_state %>%
group_by(manipulation, manipulation_level, utt, emo, state) %>%
summarize(
MAP = estimate_mode(prob),
cred_upper = hpd_upper(prob),
cred_lower = hpd_lower(prob)
)## `summarise()` has grouped output by 'manipulation', 'manipulation_level', 'utt', 'emo'. You can override using the `.groups` argument.
plot_df_state_emoIsComm <- df_state_summary[df_state_summary$manipulation == "emoIsComm_manipulation",] %>%
ggplot(., aes( x = state, y = MAP, ymin = cred_lower, ymax = cred_upper))+
geom_col(position = position_dodge())+
geom_linerange(position = position_dodge())+
ggtitle("emoIsComm manipulation")+
theme(plot.title = element_text(hjust = 0.5))+
facet_grid(rows=vars(utt, emo), cols=vars(manipulation_level))
plot_df_state_goal <- df_state_summary[df_state_summary$manipulation == "goal_manipulation",] %>%
ggplot(., aes( x = state, y = MAP, ymin = cred_lower, ymax = cred_upper))+
geom_col(position = position_dodge())+
geom_linerange(position = position_dodge())+
ggtitle("goal manipulation")+
theme(plot.title = element_text(hjust = 0.5))+
facet_grid(rows=vars(utt, emo), cols=vars(manipulation_level))
plot_df_state_state <- df_state_summary[df_state_summary$manipulation == "state_manipulation",] %>%
mutate(manipulation_level = factor(manipulation_level, levels = c("bad", "no_info", "good"))) %>%
ggplot(., aes( x = state, y = MAP, ymin = cred_lower, ymax = cred_upper))+
geom_col(position = position_dodge())+
geom_linerange(position = position_dodge())+
ggtitle("state manipulation")+
theme(plot.title = element_text(hjust = 0.5))+
facet_grid(rows=vars(utt, emo), cols=vars(manipulation_level))
plot_df_state_inference <- plot_df_state_emoIsComm + plot_df_state_goal + plot_df_state_state
plot_state_inference # human## Warning: Width not defined. Set with `position_dodge(width = ?)`
## Warning: Width not defined. Set with `position_dodge(width = ?)`
## Warning: Width not defined. Set with `position_dodge(width = ?)`
plot_df_state_inference # model## Warning: Width not defined. Set with `position_dodge(width = ?)`
## Warning: Width not defined. Set with `position_dodge(width = ?)`
## Warning: Width not defined. Set with `position_dodge(width = ?)`
### join with human data
md_state <- left_join(
df_state_summary, h_state_summary
)## Joining, by = c("manipulation", "manipulation_level", "utt", "emo", "state")
correlation table
md_state %>%
unite("utt_emo", utt, emo) %>%
mutate(
mean = ifelse(is.na(mean), 0, mean),
ci_lower = ifelse(is.na(ci_lower), 0, ci_lower),
ci_upper = ifelse(is.na(ci_upper), 0, ci_upper),
state = factor(state)
) %>%
#group_by(model) %>%
summarize(
mse = mean((MAP - mean)^2),
r = cor(MAP, mean),
r2 = r^2
) -> md_state_corr_table## `summarise()` has grouped output by 'manipulation'. You can override using the `.groups` argument.
#write_csv(md_state_corr_table, "../state_correlations.csv")
md_state_corr_table %>%
kable()| manipulation | manipulation_level | mse | r | r2 |
|---|---|---|---|---|
| emoIsComm_manipulation | comm | 0.0144897 | 0.7520564 | 0.5655888 |
| emoIsComm_manipulation | no_info | 0.0138991 | 0.8008296 | 0.6413281 |
| emoIsComm_manipulation | non_comm | 0.0209157 | 0.7501337 | 0.5627006 |
| goal_manipulation | inf | 0.0162781 | 0.7735252 | 0.5983412 |
| goal_manipulation | no_info | 0.0180507 | 0.7587487 | 0.5756995 |
| goal_manipulation | soc | 0.0165543 | 0.7944124 | 0.6310910 |
| state_manipulation | bad | 0.0635281 | 0.1146423 | 0.0131429 |
| state_manipulation | good | 0.0513105 | 0.1450050 | 0.0210265 |
| state_manipulation | no_info | 0.0509719 | 0.2007212 | 0.0402890 |
md_state %>%
unite("utt_emo", utt, emo) %>%
mutate(
mean = ifelse(is.na(mean), 0, mean),
ci_lower = ifelse(is.na(ci_lower), 0, ci_lower),
ci_upper = ifelse(is.na(ci_upper), 0, ci_upper),
state = factor(state)
) %>%
ggplot(., aes( x = MAP, xmin = cred_lower, xmax = cred_upper,
y = mean, ymin = ci_lower, ymax = ci_upper,
shape = utt_emo, color = state))+
geom_abline(intercept = 0, slope = 1, alpha = 0.3, linetype = 2)+
geom_linerange()+
geom_text(data = md_state_corr_table, x = 0.15, y = 0.93,
aes(label = paste("r=", round(r, 2), sep= "")),
inherit.aes = F)+
ggstance::geom_linerangeh()+
geom_point()+
scale_color_viridis(discrete = T)+
#xlim(0, 1)+
#ylim(0, 1)+
coord_fixed()+
facet_wrap(vars(manipulation, manipulation_level), ncol = 3)+
scale_y_continuous(limits = c(0, 1), breaks = c(0, 1))+
scale_x_continuous(limits = c(0, 1), breaks = c(0, 1))+
theme(legend.position = 'right')+
labs(
x = "Model Predicted Probability",
y = "Human Proportion Selected"
)# ggsave(filename = "bda_results/figs/bda_scatters_state_21models_cogsci.pdf", width = 18, height = 5)df_goal <- df.m %>%
filter(parameter %in% c("socGoal", "infGoal")) %>%
mutate(rating = as.numeric(value)) %>%
select(-value)
df_goal_summary <- df_goal %>%
group_by(manipulation, manipulation_level, parameter, utt, emo, rating) %>%
summarize(
MAP = estimate_mode(prob),
cred_upper = hpd_upper(prob),
cred_lower = hpd_lower(prob)
)## `summarise()` has grouped output by 'manipulation', 'manipulation_level', 'parameter', 'utt', 'emo'. You can override using the `.groups` argument.
df_inf_summary <- df_goal_summary[df_goal_summary$parameter=="infGoal",]
df_soc_summary <- df_goal_summary[df_goal_summary$parameter=="socGoal",]informational goals
plot_df_inf_emoIsComm <- df_inf_summary[df_inf_summary$manipulation == "emoIsComm_manipulation",] %>%
ggplot(., aes( x = rating, y = MAP, ymin = cred_lower, ymax = cred_upper))+
geom_col(position = position_dodge())+
geom_linerange(position = position_dodge())+
ggtitle("emoIsComm manipulation")+
xlab("inf goal") +
theme(plot.title = element_text(hjust = 0.5))+
facet_grid(rows=vars(utt, emo), cols=vars(manipulation_level))
plot_df_inf_goal <- df_inf_summary[df_inf_summary$manipulation == "goal_manipulation",] %>%
ggplot(., aes( x = rating, y = MAP, ymin = cred_lower, ymax = cred_upper))+
geom_col(position = position_dodge())+
geom_linerange(position = position_dodge())+
ggtitle("goal manipulation")+
xlab("inf goal") +
theme(plot.title = element_text(hjust = 0.5))+
facet_grid(rows=vars(utt, emo), cols=vars(manipulation_level))
plot_df_inf_state <- df_inf_summary[df_inf_summary$manipulation == "state_manipulation",] %>%
mutate(manipulation_level = factor(manipulation_level, levels = c("bad", "no_info", "good"))) %>%
ggplot(., aes( x = rating, y = MAP, ymin = cred_lower, ymax = cred_upper))+
geom_col(position = position_dodge())+
geom_linerange(position = position_dodge())+
ggtitle("state manipulation")+
xlab("inf goal") +
theme(plot.title = element_text(hjust = 0.5))+
facet_grid(rows=vars(utt, emo), cols=vars(manipulation_level))
plot_df_inf_inference <- plot_df_inf_emoIsComm + plot_df_inf_state + plot_df_inf_goal
plot_inf_inference # human## Warning: Width not defined. Set with `position_dodge(width = ?)`
## Warning: Width not defined. Set with `position_dodge(width = ?)`
## Warning: Width not defined. Set with `position_dodge(width = ?)`
plot_df_inf_inference # model## Warning: Width not defined. Set with `position_dodge(width = ?)`
## Warning: Width not defined. Set with `position_dodge(width = ?)`
## Warning: Width not defined. Set with `position_dodge(width = ?)`
# ggsave(here(paste("/models/figures/mb7_inf_inference.pdf")), width = 12, height = 6)social goals
plot_df_soc_emoIsComm <- df_soc_summary[df_soc_summary$manipulation == "emoIsComm_manipulation",] %>%
ggplot(., aes( x = rating, y = MAP, ymin = cred_lower, ymax = cred_upper))+
geom_col(position = position_dodge())+
geom_linerange(position = position_dodge())+
ggtitle("emoIsComm manipulation")+
xlab("soc goal") +
theme(plot.title = element_text(hjust = 0.5))+
facet_grid(rows=vars(utt, emo), cols=vars(manipulation_level))
plot_df_soc_goal <- df_soc_summary[df_soc_summary$manipulation == "goal_manipulation",] %>%
ggplot(., aes( x = rating, y = MAP, ymin = cred_lower, ymax = cred_upper))+
geom_col(position = position_dodge())+
geom_linerange(position = position_dodge())+
ggtitle("goal manipulation")+
xlab("soc goal") +
theme(plot.title = element_text(hjust = 0.5))+
facet_grid(rows=vars(utt, emo), cols=vars(manipulation_level))
plot_df_soc_state <- df_soc_summary[df_soc_summary$manipulation == "state_manipulation",] %>%
mutate(manipulation_level = factor(manipulation_level, levels = c("bad", "no_info", "good"))) %>%
ggplot(., aes( x = rating, y = MAP, ymin = cred_lower, ymax = cred_upper))+
geom_col(position = position_dodge())+
geom_linerange(position = position_dodge())+
ggtitle("state manipulation")+
xlab("soc goal") +
theme(plot.title = element_text(hjust = 0.5))+
facet_grid(rows=vars(utt, emo), cols=vars(manipulation_level))
plot_df_soc_inference <- plot_df_soc_emoIsComm + plot_df_soc_goal + plot_df_soc_state
plot_soc_inference #human## Warning: Width not defined. Set with `position_dodge(width = ?)`
## Warning: Width not defined. Set with `position_dodge(width = ?)`
## Warning: Width not defined. Set with `position_dodge(width = ?)`
plot_df_soc_inference # model## Warning: Width not defined. Set with `position_dodge(width = ?)`
## Warning: Width not defined. Set with `position_dodge(width = ?)`
## Warning: Width not defined. Set with `position_dodge(width = ?)`
# ggsave(here(paste("/models/figures/mb7_soc_inference.pdf")), width = 12, height = 6)md_goals <- left_join(
df_goal_summary %>%
mutate(question = factor(parameter, levels = c("infGoal", "socGoal"),
labels = c("informational goal", "social goal"))),
h_goal_summary %>% rename(rating = response)
)## Joining, by = c("manipulation", "manipulation_level", "utt", "emo", "rating", "question")
md_goals %>%
unite("utt_emo", utt, emo) %>%
mutate(
mean = ifelse(is.na(mean), 0, mean),
ci_lower = ifelse(is.na(ci_lower), 0, ci_lower),
ci_upper = ifelse(is.na(ci_upper), 0, ci_upper)
) %>%
#group_by(model, question) %>%
group_by(manipulation, manipulation_level, question) %>%
summarize(
n = n(),
mse = mean((MAP - mean)^2),
r = cor(MAP, mean),
r2 = r^2
) -> md_goal_corr_table## `summarise()` has grouped output by 'manipulation', 'manipulation_level'. You can override using the `.groups` argument.
# write_csv(md_goal_corr_table, "../goal_correlations.csv")
md_goal_corr_table %>%
kable()| manipulation | manipulation_level | question | n | mse | r | r2 |
|---|---|---|---|---|---|---|
| emoIsComm_manipulation | comm | informational goal | 16 | 0.0182186 | 0.5912451 | 0.3495707 |
| emoIsComm_manipulation | comm | social goal | 16 | 0.0127072 | 0.7055679 | 0.4978261 |
| emoIsComm_manipulation | no_info | informational goal | 16 | 0.0199157 | 0.7789773 | 0.6068056 |
| emoIsComm_manipulation | no_info | social goal | 16 | 0.0118767 | 0.7295013 | 0.5321721 |
| emoIsComm_manipulation | non_comm | informational goal | 16 | 0.0243683 | 0.7732777 | 0.5979585 |
| emoIsComm_manipulation | non_comm | social goal | 16 | 0.0133026 | 0.6673374 | 0.4453392 |
| goal_manipulation | inf | informational goal | 16 | 0.0996975 | -0.2213533 | 0.0489973 |
| goal_manipulation | inf | social goal | 16 | 0.0495317 | 0.2082617 | 0.0433729 |
| goal_manipulation | no_info | informational goal | 16 | 0.0548506 | 0.2754521 | 0.0758739 |
| goal_manipulation | no_info | social goal | 16 | 0.0189783 | 0.6504116 | 0.4230352 |
| goal_manipulation | soc | informational goal | 16 | 0.0645134 | 0.0706625 | 0.0049932 |
| goal_manipulation | soc | social goal | 16 | 0.0734896 | -0.0167098 | 0.0002792 |
| state_manipulation | bad | informational goal | 16 | 0.0320681 | 0.5955565 | 0.3546876 |
| state_manipulation | bad | social goal | 16 | 0.0157302 | 0.6195009 | 0.3837813 |
| state_manipulation | good | informational goal | 16 | 0.0198226 | 0.5380156 | 0.2894608 |
| state_manipulation | good | social goal | 16 | 0.0139533 | 0.7210089 | 0.5198538 |
| state_manipulation | no_info | informational goal | 16 | 0.0346837 | 0.5641608 | 0.3182774 |
| state_manipulation | no_info | social goal | 16 | 0.0169586 | 0.6769806 | 0.4583028 |
informational goal
md_goals %>%
filter(parameter=="infGoal") %>%
unite("utt_emo", utt, emo) %>%
mutate(
mean = ifelse(is.na(mean), 0, mean),
ci_lower = ifelse(is.na(ci_lower), 0, ci_lower),
ci_upper = ifelse(is.na(ci_upper), 0, ci_upper),
rating = factor(rating)
) %>%
ggplot(., aes( x = MAP, xmin = cred_lower, xmax = cred_upper,
y = mean, ymin = ci_lower, ymax = ci_upper,
shape = utt_emo, color = rating))+
geom_abline(intercept = 0, slope = 1, alpha = 0.3, linetype = 2)+
geom_linerange()+
geom_text(data = md_goal_corr_table, x = 0.15, y = 0.96,
aes(label = paste("r=", round(r, 2), sep= "")),
inherit.aes = F)+
ggstance::geom_linerangeh()+
geom_point()+
coord_fixed()+
#facet_grid(question~model)+
facet_wrap(vars(manipulation, manipulation_level, nrows = 3))+
scale_y_continuous(limits = c(0, 1), breaks = c(0, 1))+
scale_x_continuous(limits = c(0, 1), breaks = c(0, 1))+
theme(legend.position = 'right')+
labs(
x = "Model Predicted Probability",
y = "Human Proportion Selected"
)#ggsave(filename = "bda_results/figs/bda_scatters_goal_21models_cogsci.pdf", width = 24, height = 4.5)social goal
md_goals %>%
filter(parameter=="socGoal") %>%
unite("utt_emo", utt, emo) %>%
mutate(
mean = ifelse(is.na(mean), 0, mean),
ci_lower = ifelse(is.na(ci_lower), 0, ci_lower),
ci_upper = ifelse(is.na(ci_upper), 0, ci_upper),
rating = factor(rating)
) %>%
ggplot(., aes( x = MAP, xmin = cred_lower, xmax = cred_upper,
y = mean, ymin = ci_lower, ymax = ci_upper,
shape = utt_emo, color = rating))+
geom_abline(intercept = 0, slope = 1, alpha = 0.3, linetype = 2)+
geom_linerange()+
geom_text(data = md_goal_corr_table, x = 0.15, y = 0.96,
aes(label = paste("r=", round(r, 2), sep= "")),
inherit.aes = F)+
ggstance::geom_linerangeh()+
geom_point()+
coord_fixed()+
#facet_grid(question~model)+
facet_wrap(vars(manipulation, manipulation_level, nrows = 3))+
scale_y_continuous(limits = c(0, 1), breaks = c(0, 1))+
scale_x_continuous(limits = c(0, 1), breaks = c(0, 1))+
theme(legend.position = 'right')+
labs(
x = "Model Predicted Probability",
y = "Human Proportion Selected"
)